open Facile open Easy

let cstr n m next =
  let name = "vrp" in
  (* n targets, m ressources *)
  (* targets \in [0,n-1], ends \in [n, n+m-1], starts \in [n+m, n+2m-1] *)
  (* let nb_nodes = n+2*m in *)
  (* extremities of the partial path through node i *)
  (* do not update partial paths of start and end nodes
     to detect cycle: starts.(i) = i for i \in [n+m, n+2m-1],
     ends.(i) = i for i \in [n, n+m-1] *)
  let starts = Array.init n (fun i -> i) in
  let ends = Array.init n (fun i -> i) in
  (* start and end nodes don't have to be updated *)
  let get a i = if i < n then a.(i) else i in

  let fprint c =
    Array.iter (Printf.fprintf c "%d ") starts;
    Printf.fprintf c "\nends  : ";
    Array.iter (Printf.fprintf c "%d ") ends;
    Printf.fprintf c "\n" in

  (* for debugging *)
  let rec check_no_cycle i visited =
    match Fd.value next.(i) with
      Val ni ->
	ni >= n ||
	(Pervasives.not (List.mem ni visited) &&
	 check_no_cycle ni (ni::visited))
    | _ -> true in
  let debug_cycle () =
    for i = 0 to n-1 do
      if Pervasives.not (check_no_cycle i [i]) then
	let msg = Printf.sprintf "Vrp.cstr: cycle %d" i in
	Stak.fail msg (* failwith msg *)
    done in

  (* only unbound vars left by [create] are ided:
     targets \in [0,n-1] and starts \in [n+m, n+2m-1] *)
  let nbi = n+m in
  let next_idx i = if i < n then i else m+i in

  (* just update extremities of ppath *)
  let update_ppath i j =
    if i < n then begin
      let endsj = get ends j in
      if endsj < n then
	Data.Array.set starts endsj (get starts i) end;
    if j < n then begin
      let startsi = get starts i in
      if startsi < n then
	Data.Array.set ends startsi (get ends j) end in

  let update i =
    let i = next_idx i in
    let j = Fd.elt_value next.(i) in
    (*Fcl_debug.call 'r'
      (fun c -> Printf.fprintf c "Before\nVrp.update %d %d\n" i j; fprint c);*)
    if i < n && j < n then begin

      if ends.(j) < n then begin (* we've not reached the end *)
	(* next.(ends.(j)) should not be bound, otherwise it should
	   not be the end of a ppath, but obviously it happens *)
	(* assert (Fd.is_var next.(ends.(j)));*)
	(*if Fd.is_bound next.(ends.(j)) then
	  Printf.printf "next.(%d=ends.(%d))=%d is bound\n"
	    ends.(j) j (Fd.elt_value next.(ends.(j)));*)
	Fd.remove next.(ends.(j)) starts.(i) end;

      (*if starts.(i) < n then begin *)(* we've not reached the start *)
	(*if Fd.is_bound prev.(starts.(i)) then
	  Printf.printf "prev.(%d=starts.(%d))=%d is bound\n"
	    starts.(i) i (Fd.elt_value prev.(starts.(i)));*)
	(*Fd.remove prev.(starts.(i)) ends.(j) end *) end;
    update_ppath i j;
    (*debug_cycle ();*)
    (*Debug.call 'r'
      (fun c ->
	debug_cycle ();
	Printf.fprintf c "After\nVrp.update %d %d\n" i j; fprint c);*)
    true in

  let delay x =
    for i = 0 to nbi-1 do
      Var.delay [Fd.on_subst] next.(next_idx i) ~waking_id:i x
    done in

  Cstr.create ~name ~nb_wakings:nbi update delay


